home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / bases.arc / BASES.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-09-27  |  2.7 KB  |  120 lines
  1. {$C-}
  2.  
  3. {Converts an integer in a base between 2 and 36 inclusive to all bases
  4.  between 2 and 36 inclusive.}
  5.  
  6.  {Small modifications to clean up old messages on display, change
  7.   value request and handle overflows.
  8.  
  9.  Lew Paper
  10.  9/27/85}
  11.  
  12. Type Str255=String[255];
  13.  
  14. Function FromBase(Base: Integer; Value: Str255; Var Ok: Boolean): Integer;
  15.   Var
  16.     FB,Negative,Digit,I: Integer;
  17.   Begin
  18.     Negative:=1;
  19.     Ok:=(Base>=2) And (Base<=36);
  20.     If Ok Then
  21.      Begin
  22.       If Copy(Value,1,1)='-' Then
  23.        Begin
  24.         Value:=Copy(Value,2,254);
  25.         Negative:=-1;
  26.        End;
  27.       FB:=0;
  28.       I:=1;
  29.       While (I<=Length(Value)) And Ok Do
  30.        Begin
  31.         Digit:=Ord(Upcase(Value[I]));
  32.         Case Char(Digit) Of
  33.           '0'..'9': Digit:=Digit-48;
  34.           'A'..'Z': Digit:=Digit-55;
  35.           Else Digit:=100;
  36.          End;
  37.         If (Digit>=Base) OR (Digit > MaxInt - FB*Base)
  38.         Then
  39.             Ok:=False
  40.         ELSE
  41.             BEGIN
  42.             FB:=FB*Base+Digit;
  43.             I:=I+1;
  44.             END; {ELSE} {If (Digit>=Base) OR (Digit > MaxInt - FB*Base)}
  45.        End;
  46.      End;
  47.     FromBase:=FB*Negative;
  48.     If Not Ok Then FromBase:=0;
  49.   End;
  50.  
  51. Function ToBase(Base,Value: Integer; Var Ok: Boolean): Str255;
  52.   Var TB: Str255;
  53.       Negative: String[1];
  54.       D: Integer;
  55.   Const Digits: Array [0..35] Of Char='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  56.   Begin
  57.     Ok:=(Base>=2) And (Base<=36);
  58.     If Not Ok Then TB:='Illegal base'
  59.     Else
  60.      Begin
  61.       Negative:='';
  62.       If Value<0 Then Negative:='-';
  63.       TB:='';
  64.       Repeat
  65.         D:=Value Mod Base;
  66.         If D<0 Then D:=-D;
  67.         TB:=Digits[D]+TB;
  68.         Value:=Value Div Base;
  69.       Until Value=0;
  70.       TB:=Negative+TB;
  71.      End;
  72.     ToBase:=TB;
  73.   End;
  74.  
  75. Var
  76.   Base,ABase,Result: Integer;
  77.   Value: Str255;
  78.   Ok: Boolean;
  79.  
  80. Begin
  81.   ClrScr;
  82.   For Base:=2 To 36 Do
  83.    Begin
  84.     GotoXY(1+39*((Base-1) Div 18),1+(Base-1) Mod 18);
  85.     Write(Base:2,':');
  86.    End;
  87.   Repeat
  88.     GotoXY(1,20);
  89.     Write('Enter base to convert from (0 to end): ');
  90.     ClrEol;
  91.     ReadLn(ABase);
  92.     If ABase=0
  93.     Then
  94.         BEGIN
  95.         GoToXY(1, 22);
  96.         ClrEol;
  97.         Halt;
  98.         END; {If ABase=0}
  99.     Write('Enter value to convert: ');
  100.     ClrEol;
  101.     ReadLn(Value);
  102.     ClrEol;
  103.     Result:=FromBase(ABase,Value,Ok);
  104.     If Not Ok Then WriteLn('Illegal base or value')
  105.     Else
  106.      Begin
  107.       For Base:=2 To 36 Do
  108.        Begin
  109.         Value:=ToBase(Base,Result,Ok);
  110.         GotoXY(5+39*((Base-1) Div 18),1+(Base-1) Mod 18);
  111.         If Base=ABase Then LowVideo
  112.         Else NormVideo;
  113.         Write(Value);
  114.         NormVideo;
  115.         Write('               ');
  116.        End;
  117.      End;
  118.    Until False;
  119. End.
  120.